home *** CD-ROM | disk | FTP | other *** search
/ Netscape Plug-Ins Developer's Kit / Netscape_Plug-Ins_Developers_Kit.iso / CGIPERL / MACPERL / MSRCE418.HQX / Perl Source ƒ / Perl / t / io / fs.t < prev    next >
Encoding:
Text File  |  1994-12-27  |  3.0 KB  |  87 lines
  1. #!./perl
  2.  
  3. # $RCSfile: fs.t,v $$Revision: 4.0.1.1 $$Date: 1993/02/05 19:44:34 $
  4.  
  5. print "1..22\n";
  6.  
  7. $wd = `directory`;
  8. chop($wd);
  9.  
  10. `Delete -y tmp`; 
  11. `NewFolder tmp│Dev:Null`;
  12. chdir ':tmp';
  13. `delete -y a b c x`;
  14.  
  15. # umask(022);
  16.  
  17. # if ((umask(0)&0777) == 022) {print "ok 1\n";} else {print "not ok 1\n";}
  18. open(fh,'>x') || die "Can't create x";
  19. close(fh);
  20. open(fh,'>a') || die "Can't create a";
  21. close(fh);
  22.  
  23. if (symlink('a','b')) {print "ok 2\n";} else {print "not ok 2\n";}
  24.  
  25. if (symlink('b','c')) {print "ok 3\n";} else {print "not ok 3\n";}
  26.  
  27. ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  28.   $blksize,$blocks) = stat('c');
  29.  
  30. # if ($nlink == 3) {print "ok 4\n";} else {print "not ok 4\n";}
  31. # if (($mode & 0777) == 0666) {print "ok 5\n";} else {print "not ok 5\n";}
  32.  
  33. # if ((chmod 0777,'a') == 1) {print "ok 6\n";} else {print "not ok 6\n";}
  34.  
  35. # ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  36. #    $blksize,$blocks) = stat('c');
  37. # if (($mode & 0777) == 0777) {print "ok 7\n";} else {print "not ok 7\n";}
  38.  
  39. # if ((chmod 0700,'c','x') == 2) {print "ok 8\n";} else {print "not ok 8\n";}
  40.  
  41. # ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  42. #     $blksize,$blocks) = stat('c');
  43. # if (($mode & 0777) == 0700) {print "ok 9\n";} else {print "not ok 9\n";}
  44. # ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  45. #     $blksize,$blocks) = stat('x');
  46. # if (($mode & 0777) == 0700) {print "ok 10\n";} else {print "not ok 10\n";}
  47.  
  48. if ((unlink 'x') == 1) {print "ok 11\n";} else {print "not ok 11\n";}
  49. # ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  50. #     $blksize,$blocks) = stat('b');
  51. # if ($ino == 0) {print "ok 12\n";} else {print "not ok 12\n";}
  52. ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  53.     $blksize,$blocks) = stat('x');
  54. if ($ino == 0) {print "ok 13\n";} else {print "not ok 13\n";}
  55.  
  56. if (rename('a','b')) {print "ok 14\n";} else {print "not ok 14\n";}
  57. ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  58.     $blksize,$blocks) = stat('a');
  59. if ($ino == 0) {print "ok 15\n";} else {print "not ok 15\n";}
  60. # $foo = (utime 500000000,500000001,'b');
  61. # if ($foo == 1) {print "ok 16\n";} else {print "not ok 16 $foo\n";}
  62. ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  63.     $blksize,$blocks) = stat('b');
  64. if ($ino) {print "ok 17\n";} else {print "not ok 17\n";}
  65. if (($atime == 500000000 && $mtime == 500000001) || $wd =~ m#/afs/#)
  66.     {print "ok 18\n";}
  67. else
  68.     {print "not ok 18 $atime $mtime\n";}
  69.  
  70. if ((unlink 'b') == 1) {print "ok 19\n";} else {print "not ok 19\n";}
  71. ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  72.     $blksize,$blocks) = stat('b');
  73. if ($ino == 0) {print "ok 20\n";} else {print "not ok 20\n";}
  74. unlink 'c';
  75.  
  76. chdir $wd || die "Can't cd back to $wd";
  77.  
  78. unlink 'c';
  79. if (`ls -l perl 2>/dev/null` =~ /^l.*->/) {  # we have symbolic links
  80.     if (symlink("TEST","c")) {print "ok 21\n";} else {print "not ok 21\n";}
  81.     $foo = `grep perl c`;
  82.     if ($foo) {print "ok 22\n";} else {print "not ok 22\n";}
  83. }
  84. else {
  85.     print "ok 21\nok 22\n";
  86. }
  87.